CD ROM Paradise Collection 4

home *** CD-ROM | disk | FTP | other *** search

/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / URASM.SCR < prev next >

Wrap

Text File | 1994-10-30 | 34KB | 1 lines

\ 8086 assembler FOR UR/FORTH 08:03 12/01/86 Contents copyright (C) 1985 by Thomas Almy. All rights reserved. This assembler is compatible with the CFORTH 8086 assembler. Purchasers of CFORTH may use this assembler to assist in developing programs using a Forth interpreter for later compilation with CFORTH, since it conforms with that assembler. Additions and exceptions are noted on the following screens This assembler is designed to work only with LMI UR/FORTH 1.0 The assembler in ASM.SCR, for PC/Forth 3.1 is more portable. ( 22:15 11/18/85 ) --> Additions to assembler NEXT, -- Generates code to jump back to inner interpreter Use instead of RET or JMPI in CFORTH. Return address is automatically saved on return stack. IN/OUT -- When used, causes a code preamble to be generated by CODE and ;CODE, and different code by NEXT, so as to match the register interface of CFORTH (Arguments/ results in AX and BX, SI is free). NOIN/OUT -- No special code is generated. When neither IN/OUT or NOIN/OUT are used: a code preamble is generated by CODE and ;CODE, and different code by NEXT, so as to match the register interface of CFORTH (SI is free). \ 10:02 12/01/86 --> CALL' name -- Generates code to do a threaded-call of "name". Top of stack is in BX for this call if NOIN/OUT is used, otherwise all arguments passed on stack. Assembler exceptions 1. L: generates a header, thus taking space, so labels cannot be declared in the middle of executable code. 2. You cannot use the CALL or JMP instruction to go to another code word, (or high level, of course!). \ MAKE AN OVERLAY 08:06 12/01/86 : OVERLAY ; 4 LOAD : ASMCF ; : OVERLAY ; 4 LOAD : ASMCF ; BSAVE OVERLAY ASMCF ( assembler for CForth ) FORGET OVERLAY FORGET OVERLAY 0 .IF \ Execute the following commands in PC/FORTH (or 8086 FORTH) \ to add the command ASMCF to your Forth system which will load \ the assembler when executed. : ASMCF BGET ASMCF ." Assembler loaded." CR ; SAVE FORTH .THEN \ LOAD THE ASSEMBLER 08:13 12/01/86 FORTH DEFINITIONS DECIMAL 5 32 THRU ASM EXCISE DSPHLD SEGOVR EXCISE SETUP 2SEG EXCISE RESETASM noinout EXCISE RESOLVE RESOLVE FORTH DEFINITIONS DECIMAL \ 8086 ASSEMBLER 13:17 12/01/86 VOCABULARY ASM IMMEDIATE ASM DEFINITIONS HEX 0 EQU DSPHLD ( HOLDS DISPLACEMENTS ) 0 EQU LITHLD ( HOLDS LITERALS ) 0 EQU INSTR ( INSTRUCTION START ) VARIABLE INSPTR ( POINTER TO OPERATION PARMS ) 0 EQU BYTE? ( BYTE INSTRUCTION ) 10 CONSTANT lit : CS@ CS0 SWAP @L ; : CSC@ CS0 SWAP C@L ; : CS! CS0 SWAP !L ; : CSC! CS0 SWAP C!L ; : THERE CP @ ; : OFFSET THERE 1- - ; : SETINS THERE EQU INSTR ; \ 8086 REGISTER DEFINING WORDS 13:17 12/01/86 : BREG CREATE , DOES> -1 EQU BYTE? @ ; : DSPMOD CREATE C, DOES> C@ SWAP EQU DSPHLD ; : REGMOD CREATE C, DOES> C@ 0 EQU DSPHLD ; : SEGOVR CREATE 26 + C, DOES> SETINS C@ CSC, ; \ USER REGISTER DEFINITIONS 13:14 12/01/86 0 CONSTANT AX 1 CONSTANT CX 2 CONSTANT DX 3 CONSTANT BX 4 CONSTANT SP 5 CONSTANT BP 6 CONSTANT SI 7 CONSTANT DI -1 CONSTANT [CL] -1 CONSTANT [DX] ( sometimes needed ) 0 CONSTANT ES 8 CONSTANT CS 10 CONSTANT SS 18 CONSTANT DS 0 BREG AL 1 BREG CL 2 BREG DL 3 BREG BL 4 BREG AH 5 BREG CH 6 BREG DH 7 BREG BH 08 REGMOD [BX+SI] 09 REGMOD [BX+DI] 0A REGMOD [BP+SI] 0B REGMOD [BP+DI] 0C REGMOD [SI] 0D REGMOD [DI] 0E REGMOD [BP] 0F REGMOD [BX] 11 DSPMOD [] ( DIRECT ADDRESSING -- MODE 11 ) 08 DSPMOD +[BX+SI] 09 DSPMOD +[BX+DI] 0A DSPMOD +[BP+SI] 0B DSPMOD +[BP+DI] 0C DSPMOD +[SI] 0D DSPMOD +[DI] 0E DSPMOD +[BP] 0F DSPMOD +[BX] : # EQU LITHLD lit ; ( LITERALS ARE MODE 10 ) ES SEGOVR ES: CS SEGOVR CS: SS SEGOVR SS: DS SEGOVR DS: ( ADDRESS FIELD COMPUTATION 18:17 03/05/86 ) : BYTE -1 EQU BYTE? ; ( sometimes needed ) : SETUP INSPTR ! SETINS ; : BUMP 1 INSPTR +! ; : 8* 8 * ; : ?BYTE BYTE? IF 0 EQU BYTE? 1- THEN ; : SETDIR ( ARG ARG -- REG/IMM ARG , DIR FLAG MAY BE SET) OVER 7 U> IF SWAP INSTR CS@ 2+ INSTR CS! THEN ; ( ADDRESS FIELD COMPUTATION 18:17 03/05/86 ) : 1IM ( ONE IMMEDIATE ) DUP lit = IF DROP LITHLD DUP ABS 80 U< IF INSPTR @ C@ 2+ CSC, CSC, ELSE INSPTR @ C@ CSC, CS, THEN R> DROP ELSE BUMP THEN ; ( ADDRESS FIELD COMPUTATION 18:15 03/05/86 ) : SETDSP ( value -- , set DSPHLD ) DUP 11 <> IF ." DIRECT ADDRESSING ASSUMED " EQU DSPHLD ELSE DROP THEN ; : ADRFLD ( REGISTER ARGUMENT -- ) DUP 8 U< IF ( REG-REG ) SWAP 8* + 0C0 + CSC, ELSE DUP 11 U< IF ( NOT DIRECT ) 8 - DSPHLD 0= OVER 6 <> AND IF ( no DISP ) SWAP 8* + CSC, ELSE DSPHLD ABS 80 U< IF ( short DISP ) SWAP 8* + 40 + CSC, DSPHLD CSC, ELSE \ long DISP SWAP 8* + 80 + CSC, DSPHLD CS, THEN THEN ELSE ( direct addressing ) SETDSP 8* 6 + CSC, DSPHLD CS, THEN THEN ; ( INSTRUCTION MODES 21:52 01/29/86 ) : 0MD ( NO ARGS ) CREATE C, DOES> SETINS C@ CSC, ; : 0MDB ( 0 args, byte possible ) CREATE C, DOES> SETINS C@ ?BYTE CSC, ; : 1RG ( ONE REGISTER ) DUP 8 U< BYTE? 0= AND IF INSPTR @ C@ + CSC, R> DROP ELSE BUMP THEN ; : 1MEM ( REG/MEMORY ) INSPTR @ DUP C@ ?BYTE CSC, 1+ C@ SWAP ADRFLD ; : 1MD ( 1 arg, register or memory ) CREATE C, C, C, DOES> SETUP 1RG 1MEM ; ( INSTRUCTION MODES 21:59 01/29/86 ) : 1MPU ( Push instruction, 80186 >= compatible ) CREATE C, C, C, C, DOES> SETUP 1IM 1RG 1MEM ; : 1MDX ( 1 argument, no special register form ) CREATE C, C, DOES> SETUP 1MEM ; : 1MDS ( shifts, this is 80186 >= compatible ) CREATE C, DOES> SETUP DUP [CL] = IF >R 0D3 ELSE DUP >R 1 = IF 0D1 ELSE 0C1 THEN THEN ?BYTE CSC, INSPTR @ C@ SWAP ADRFLD R> DUP 1 > IF CSC, ELSE DROP THEN ; : 1MDIO ( io instructions ) CREATE C, DOES> SETUP DUP [DX] = IF INSPTR @ C@ 8 + ?BYTE CSC, DROP ELSE INSPTR @ C@ ?BYTE CSC, CSC, THEN ; ( INSTRUCTION MODES 21:59 01/29/86 ) : 2IMA ( Immediate , accumulator destination ) 2DUP lit 0 D= IF 2DROP INSPTR @ C@ ?BYTE DUP CS, LITHLD SWAP 1 AND IF CS, ELSE CSC, THEN R> DROP ELSE BUMP THEN ; : 2IMRMA ( Immediate , register/memory destination, arith.) OVER lit = IF SWAP DROP INSPTR @ DUP C@ ?BYTE DUP >R CSC, 1+ C@ SWAP ADRFLD LITHLD R> 1 AND IF DUP ABS 80 U< IF INSTR C@ 2+ INSTR C! CSC, ELSE CS, THEN ELSE CSC, THEN R> DROP ELSE BUMP BUMP THEN ; ( INSTRUCTION MODES 21:59 01/29/86 ) : 2IMRML ( immediate, reg/mem destination, logical ) OVER lit = IF SWAP DROP INSPTR @ DUP C@ ?BYTE DUP >R CSC, 1+ C@ SWAP ADRFLD LITHLD R> 1 AND IF CS, ELSE CSC, THEN R> DROP ELSE BUMP BUMP THEN ; : 2MEM ( register to/from register/memory ) INSPTR @ C@ ?BYTE CSC, SETDIR ADRFLD ; ( INSTRUCTION MODES 06:57 11/10/85 ) : 2MD ( immed to accum, immed to reg, reg to reg/mem, arith) CREATE C, C, C, C, DOES> SETUP 2IMA 2IMRMA 2MEM ; : 2MDI ( immed to accum, immed to reg, reg to reg/mem, logic) CREATE C, C, C, C, DOES> SETUP 2IMA 2IMRML 2MEM ; : 2MDN ( reg/mem to reg ) CREATE C, DOES> SETUP SWAP 2MEM ; ( INSTRUCTION MODES 21:17 01/30/86 ) : 2MDM ( move, many modes! ) CREATE C, C, C, DOES> SETUP OVER 0= OVER 10 U> AND IF ( ACC TO MEM ) 0A3 ?BYTE CSC, SETDSP DSPHLD CS, DROP EXIT THEN OVER 10 U> OVER 0= AND IF ( MEM TO ACC ) 0A1 ?BYTE CSC, DROP SETDSP DSPHLD CS, EXIT THEN OVER lit = OVER 8 U< AND IF ( IMMED TO REG ) SWAP DROP LITHLD SWAP ( GET RIGHT ARGS ) BYTE? IF 0 EQU BYTE? 0B0 ELSE 0B8 THEN SWAP OVER + CSC, 8 AND IF ( WORD ) CS, ELSE CSC, THEN EXIT THEN 2IMRML 2MEM ; ( SEGMENT REGISTER INSTRUCTIONS 06:59 11/10/85 ) : 1SEG ( single segment register instruction ) CREATE C, DOES> SETINS C@ + CSC, ; : 2SEG ( segment register and reg/mem, seg reg on top ) CREATE C, DOES> SETUP 8 / SWAP 2MEM ; \ BRANCH CONDITIONS, CALL 13:18 12/01/86 70 CONSTANT LOOPNZ 72 CONSTANT LOOP 8 CONSTANT <0 4 CONSTANT =0 2 CONSTANT <U 7 CONSTANT >U 0F CONSTANT >S 0C CONSTANT <S 0 CONSTANT OV ( overflow ) 0A CONSTANT PE ( even parity ) : ~ 1 XOR ; ( CHANGE SENSE STATE ) : CALL SETINS 0E8 C, OFFSET 3 - , ; ( CONDITIONAL JUMPS, UNCONDITIONAL JUMPS, 06:37 11/10/85 ) ( CONDITIONAL JUMP -- TARGET ADDRESS KNOWN ) : JMPC SETINS 70 + CSC, OFFSET 2- DUP ABS 7F U> ( OPS, NEED LONG FORM ) IF INSTR CSC@ ~ INSTR CSC! 3 CSC, 0E9 CSC, 3 - CS, ELSE CSC, THEN ; ( UNCONDITIONAL JUMP -- TARGET ADDRESS KNOWN ) : JMP SETINS DUP 10 U< IF FF CSC, 4 SWAP ADRFLD ELSE 0EB CSC, ( RELATIVE ADDRESS ) OFFSET 2- DUP ABS 7F > ( OPS, NEED LONG FORM ) IF 0E9 INSTR CSC! 1- CS, ELSE CSC, THEN THEN ; ( FORWARD JUMPS 06:39 11/10/85 ) ( CONDITIONAL JUMP -- TARGET ADDRESS UNKNOWN, USE SHORT FORM ) : JMPCF SETINS 70 + CSC, 0 CSC, INSTR ; ( UNCONDITIONAL JUMP -- TARGET ADDRESS UNKNOWN, FORCE LONG JMP) : JMPF THERE 300 + JMP ; ( NILADIC OPERATIONS 15:18 03/01/86 ) 8 BASE ! 231 0MD CWD 303 0MD RET 230 0MD CBW 317 0MD IRET 362 0MD REPNZ 363 0MD REPZ 245 0MDB MOVS 247 0MDB CMPS 257 0MDB SCAS 255 0MDB LODS 253 0MDB STOS 374 0MD CLD 375 0MD STD 372 0MD CLI 373 0MD STI 370 0MD CLC 365 0MD CMC 371 0MD STC ( MONADIC OPERATIONS 22:07 01/29/86 ) 06 377 120 150 1MPU PUSH 00 217 130 1MD POP 06 1SEG PUSHSEG 07 1SEG POPSEG 00 377 100 1MD INC 01 377 110 1MD DEC 02 377 1MDX CALLI 04 377 1MDX JMPI 04 367 1MDX MUL 05 367 1MDX IMUL 06 367 1MDX DIV 07 367 1MDX IDIV 03 367 1MDX NEG 02 367 1MDX NOT ( MONADIC OPERATIONS 22:08 01/29/86 ) 04 1MDS SHL 05 1MDS SHR 07 1MDS SAR 00 1MDS ROL 01 1MDS ROR 02 1MDS RCL 03 1MDS RCR 345 1MDIO IN 347 1MDIO OUT ( MONADIC OPERATIONS 15:19 03/01/86 ) : INT DUP 3 = IF 314 CSC, DROP ELSE 315 CSC, CSC, THEN ; HEX : XCHG SETINS 2DUP U< IF SWAP THEN DUP 0= BYTE? 0= AND IF OVER 8 U< IF DROP 90 + CSC, EXIT THEN THEN 87 ?BYTE CSC, SWAP ADRFLD ; 8 BASE ! ( DIADIC OPERATIONS 22:11 01/29/86 ) 001 00 201 005 2MD ADD 051 05 201 055 2MD SUB 021 02 201 025 2MD ADC 031 03 201 035 2MD SBB 071 07 201 075 2MD CMP 041 04 201 045 2MDI AND 205 00 367 251 2MDI TEST 011 01 201 015 2MDI OR 061 06 201 065 2MDI XOR ( DIADIC OPERATIONS 22:12 01/29/86 ) 216 2SEG >SEG ( copouts ) 214 2SEG <SEG 215 2MDN LEA 305 2MDN LDS 304 2MDN LES 211 00 307 2MDM MOV HEX ( BRANCH CONSTRUCTIONS 22:13 01/29/86 ) : RESOLVE ( JMPINSTRADDR TARGET -- ) OVER - OVER CSC@ 0E9 = IF ( UNCOND. LONG) 3 - SWAP 1+ CS! ELSE DUP ABS 80 < IF ( GOOD CASE ! ) 2- SWAP 1+ CSC! ELSE -1 ABORT" branch target out of range " 2DROP THEN THEN ; : IF, ( CC -- REF ) ~ JMPCF ; : THEN, ( REF -- ) THERE RESOLVE ; : FWD, ( -- REF , uncond forward jmp, resolve with "then" ) JMPF THERE 3 - ; : ELSE, ( REF -- REF ) THERE 3 + RESOLVE FWD, ; : BEGIN, ( -- ADDR ) THERE ; : UNTIL, ( ADDR CC -- ) ~ JMPC ; : WHILE, IF, ; : REPEAT, SWAP JMP THEN, ; : RESETASM ASM 0 EQU BYTE? 0 EQU LITHLD 0 EQU DSPHLD ; \ WINDOW DRESSING 08:36 12/01/86 -1 EQU incnt -1 EQU outcnt 0 EQU noinout FORTH DEFINITIONS : IN/OUT 2DUP MIN 0< >R 2DUP MAX 2 > R> OR ABORT" Bad IN/OUT specification" ASM EQU outcnt EQU incnt ; : NOIN/OUT ASM -1 EQU noinout ; : L: ASM THERE CONSTANT RESETASM [COMPILE] ASM ; \ MORE WINDOW DRESSING 08:41 12/01/86 ASM DEFINITIONS : END-CODE [COMPILE] FORTH 0 EQU noinout -1 EQU incnt -1 EQU outcnt ; : CALL' noinout 0= IF ASM BX POP FORTH THEN HERE ASM # SI MOV LODS AX JMP FORTH ' , THERE , noinout 0= IF ASM BX PUSH FORTH THEN ; \ MORE WINDOW DRESSING 08:41 12/01/86 : NEXT, noinout 0= IF outcnt 0< IF ( no in/out spec'd ) ASM BP SP XCHG SI POP BP SP XCHG BX POP ELSE ( in/out specified ) SI POP outcnt CASE 0 OF BX POP ENDOF 1 OF AX BX MOV ENDOF 2 OF BX PUSH AX BX MOV ENDOF ENDCASE THEN THEN ASM LODS AX JMP ; FORTH DEFINITIONS \ STILL MORE WINDOW DRESSING 10:07 12/01/86 : CODE HEADER [COMPILE] ASM ASM RESETASM noinout 0= IF incnt 0< IF BX PUSH BP SP XCHG SI PUSH BP SP XCHG \ BP saved on retstk ELSE incnt CASE 0 OF BX PUSH ENDOF 1 OF BX AX MOV ENDOF 2 OF BX AX MOV BX POP ENDOF ENDCASE SI PUSH THEN THEN ; ( STILL MORE WINDOW DRESSING 22:14 01/29/86 ) : ;CODE ?CSP UNSMUDGE COMPILE (;CODE) ASM THERE , [COMPILE] ASM RESETASM noinout 0= IF incnt 0< IF BX PUSH DI PUSH ( all args now on stack ) BP SP XCHG SI PUSH BP SP XCHG ELSE incnt CASE 0 OF ABORT" There must be at least one argument" ENDOF 1 OF DI AX MOV BX PUSH ENDOF 2 OF DI AX MOV ENDOF ENDCASE SI PUSH ( save IP ) THEN THEN [COMPILE] [ ; IMMEDIATE